home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1995 November / Macworld Nov ’95.toast / Developers / Selection ƒ 2.5 / pushButton < prev    next >
Encoding:
Text File  |  1994-11-06  |  1.9 KB  |  98 lines  |  [TEXT/MSET]
  1.  \ 28Oct94 dbh updated to 2.5 syntax 
  2.  
  3. (*
  4.  
  5. A pushButton and checkBox+ will function as is without any required
  6. setup.  They have default titles and positions, and will respond
  7. appropriately to mouse clicks.  These controls are selection objects.
  8. Action handlers must be installed in order for these controls to actually
  9. do anything.
  10.  
  11. *)
  12.  
  13.  
  14. :class    pushButton super{ baseControl }
  15.  
  16.     dicAddr        ACTION
  17.     $16    cTitle
  18.  
  19. :m INIT:  ( x y addr len -- )
  20.     put: cTitle
  21.     puttopy: bounds
  22.     puttopx: bounds ;m 
  23.  
  24. :m ACTION:    \ ( cfa -- )  Sets the action for this control
  25.     put: action  ;m 
  26.  
  27. :m new:  { wptr -- }  \ must be compatible with selection objects
  28.     wptr put: wind
  29.     get: procID  8 and        \ window font if true
  30.     NIF  0 tFont 12 tSize  ( Chicago 12 )  THEN
  31.     get: cTitle mStringWidth ( dx) 5 + 17  ( dy)  setsize: bounds
  32.     get: procID konst pushButProc =
  33.     NIF 16 0 stretch: bounds THEN  \ must account for width of checkbox/radiobutton
  34.     0  wptr  bounds ( rptr)  get$: cTitle
  35.     w 256  word0  word0  w 1  int: procid
  36.     self \ refcon
  37.     call NewControl  put: ctlHndl
  38.     ;m    
  39.  
  40. :m SETTITLE:    \ (  addr len -- )
  41.     put: cTitle
  42.     alive?: self
  43.     IF
  44.         get: ctlHndl  get$: cTitle  call setCTitle
  45.     THEN ;m 
  46.  
  47. :m GETTITLE:    \ ( -- addr len )
  48.     get: cTitle ;m  \ we always maintain cTitle, alive or not
  49.  
  50. :m CLASSINIT:    \ Sets default control to a standard button
  51.     konst pushButProc  put: procID
  52.     ['] null  action: self
  53.     50 50 moveto: bounds
  54.     " pushButton" put: cTitle ;m
  55.  
  56. :m exec: ( part# -- )
  57.     IF        \ action only if in same control part
  58.      get: action  execute
  59.     THEN ;m
  60.  
  61. ;class
  62.  
  63. :class    CHECKBOX+  super{ pushButton }
  64.  
  65. :m toggle:
  66.     get: self
  67.     IF    0
  68.     ELSE 1
  69.     THEN  put: self ;m
  70.  
  71. :m exec:    ( part# -- )
  72.     IF
  73.         toggle: self
  74.         get: action execute
  75.     THEN ;m
  76.  
  77. :m CLASSINIT:
  78.       classinit: super
  79.       konst checkBoxProc  put: procID
  80.       " Checkbox+" put: cTitle ;m
  81.  
  82. ;class
  83.  
  84.  
  85. endload
  86.  
  87. *** EXAMPLE USE
  88.  
  89. selwindow w
  90. test: w
  91.  
  92. pushButton b
  93. b add: w
  94.  
  95. pushButton bb
  96. 20 20 moveto: bb
  97. bb add: w
  98.